home *** CD-ROM | disk | FTP | other *** search
/ CDUTIL 13 / CDUTIL #13 Julio 1995.iso / windows / acadwin / support / ddrename.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  22.6 KB  |  597 lines
  1. ; Next available MSG number is    33 
  2. ; MODULE_ID DDRENAME_LSP_
  3. ;;;----------------------------------------------------------------------------
  4. ;;;
  5. ;;;   DDRENAME.LSP   Version 0.5
  6. ;;;
  7. ;;;   (C) Copyright 1991-1994 by Autodesk, Inc.
  8. ;;;      
  9. ;;;   Permission to use, copy, modify, and distribute this software 
  10. ;;;   for any purpose and without fee is hereby granted, provided 
  11. ;;;   that the above copyright notice appears in all copies and that 
  12. ;;;   both that copyright notice and this permission notice appear in 
  13. ;;;   all supporting documentation.
  14. ;;;      
  15. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  16. ;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  17. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  18. ;;;   
  19. ;;;----------------------------------------------------------------------------
  20. ;;;  DESCRIPTION
  21. ;;;
  22. ;;;  An AutoLISP implementation of the AutoCAD command RENAME with a dialogue 
  23. ;;;  interface.  Unlike its command counterpart, DDRENAME supports wildcard
  24. ;;;  matching (* and ?), requested particularly by users for manipulating
  25. ;;;  bound Xref symbol table items (aka named objects) with long names. 
  26. ;;;  
  27. ;;;  DESIGN OUTLINE
  28. ;;;  
  29. ;;;  For each table selected, a list is generated of items in that table.
  30. ;;;  Renamed items are substituted into the list and on OK this new list
  31. ;;;  is compared to the original list and differing items are put through
  32. ;;;  the AutoCAD rename command. 
  33. ;;; 
  34. ;;;----------------------------------------------------------------------------
  35. ;;;   Prefixes in command and keyword strings: 
  36. ;;;      "."  specifies the built-in AutoCAD command in case it has been        
  37. ;;;           redefined.
  38. ;;;      "_"  denotes an AutoCAD command or keyword in the native language
  39. ;;;           version, English.
  40. ;;;----------------------------------------------------------------------------
  41. ;;;
  42. ;;; ===========================================================================
  43. ;;; ===================== load-time error checking ============================
  44. ;;;
  45.  
  46.   (defun ai_abort (app msg)
  47.      (defun *error* (s)
  48.         (if old_error (setq *error* old_error))
  49.         (princ)
  50.      )
  51.      (if msg
  52.        (alert (strcat " Error en la aplicaci≤n: "
  53.                       app
  54.                       " \n\n  "
  55.                       msg
  56.                       "  \n"
  57.               )
  58.        )
  59.      )
  60.      (exit)
  61.   )
  62.  
  63. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  64. ;;; and then try to load it.
  65. ;;;
  66. ;;; If it can't be found or it can't be loaded, then abort the
  67. ;;; loading of this file immediately, preserving the (autoload)
  68. ;;; stub function.
  69.  
  70.   (cond
  71.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  72.  
  73.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  74.         (ai_abort "DDRENAME"
  75.                   (strcat "Imposible localizar el archivo AI_UTILS.LSP."
  76.                           "\n Compruebe el directorio de soporte.")))
  77.  
  78.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  79.         (ai_abort "DDRENAME" "Imposible cargar el archivo AI_UTILS.LSP"))
  80.   )
  81.  
  82.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  83.       (ai_abort "DDRENAME" nil)         ; a Nil <msg> supresses
  84.   )                                    ; ai_abort's alert box dialog.
  85.  
  86. ;;; ==================== end load-time operations ===========================
  87.  
  88. ;;;----------------------------------------------------------------------------
  89. ;;;  The main function.
  90. ;;;----------------------------------------------------------------------------
  91. (defun c:ddrename (/ 
  92.         $value                             olderr               style_items     
  93.                           globals          old_cmd              tables          
  94.         block_items       highlight        old_indices          table_item      
  95.         chflag            i                old_pattern          table_items     
  96.         cmd               item1            old_pattern_length   table_list      
  97.         cmd_old           item2            old_star             table_name      
  98.         command_rename    j                one_index            table_selection 
  99.         count             just_name        orig_list            ucs_items       
  100.         current_items     layer_items      pat_length           update_list     
  101.         dcl_id            list1            pat_letter           view_items      
  102.         list_name_new     group_items      pick_items           vport_items     
  103.         defined_names     ltype_items      rename               undo_init
  104.         dimstyle_items    n                rename_err          
  105.         ddrename_main     n1               rename_list         
  106.         do_new            new_item_list    report_error        
  107.         do_old            new_name         rs_error            
  108.         do_tables1        new_name_list    s                   
  109.         do_tables2        new_pattern                      
  110.        ) 
  111.   ;;
  112.   ;; Action on Old Name edit box.
  113.   ;;
  114.   ;(defun do_old()
  115.   ;  (set_tile "table_items" "")
  116.   ;  (rs_error)
  117.   ;  (setq report_error 1)
  118.   ;  (do_old)
  119.   ;)
  120.   ;;
  121.   ;; Reset the error tile.
  122.   ;;
  123.   (defun rs_error()
  124.     (set_tile "error" "")
  125.   )
  126.   ;;
  127.   ;; This routine is called when a pick is made in the table list box, the
  128.   ;; one that displays Block, Layer, Linetype, etc.  
  129.   ;;
  130.   (defun table_selection()
  131.     (set_tile "error" "")               ; Clear the error tile.
  132.     (do_tables1)                        ; Display items in selected table.
  133.     (if (= "*varφa*" (get_tile "old")) ; If old name is *varies*, 
  134.       (set_tile "old" "")                 ; clear it,
  135.       (progn                              ; else use it to highlight new items.
  136.         (setq report_error 0)
  137.         (do_old)
  138.       )
  139.     )
  140.   )
  141.   ;;
  142.   ;; This routine is called when a pick is made in the table items list box,
  143.   ;; the one that displays the items in the selected table. 
  144.   ;;
  145.   (defun table_items()
  146.     (set_tile "error" "")               ; clear the error tile.
  147.     (setq pick_items (get_tile "table_items"))   ; find the highlight items.
  148.     (cond
  149.       ((= "" pick_items) (set_tile "old" ""))    ; no items selected
  150.       ((= "" (substr pick_items (+ 2 (strlen (itoa (read pick_items))))))  
  151.         (set_tile "old" (nth (atoi $value) current_items)) ; if 1 item selected
  152.       )                                                    ; display its name.
  153.       (T (set_tile "old" "*varφa*"))          ; else display *varies*.
  154.     )
  155.   )
  156.   ;;
  157.   ;;  This routine displays a new title on the table item list box.
  158.   ;;
  159.   (defun do_tables1()
  160.     (setq table_name (nth (atoi $value) tables))
  161.  
  162.     ;; This (cond) is added for translation purposes.  The list of symbol
  163.     ;; tables in the dialogue box will appear in the local language but 
  164.     ;; they must be translated to American so that AutoCAD can understand.
  165.     ;; When translating these strings make sure they correspond exactly
  166.     ;; and precisely to those modified in the table list defined at the
  167.     ;; start of the ddrename_main() function further down the file.
  168.     (cond
  169.       ((= table_name "Bloque")         ; translate this
  170.         (setq table_name ;|MSG0|;"block")     ; do not translate
  171.       )
  172.       ((= table_name "Estilo acotaci≤n")      ; translate this  
  173.         (setq table_name ;|MSG0|;"dimstyle")  ; do not translate
  174.       )
  175.       ((= table_name "Capa")         ; translate this   
  176.         (setq table_name ;|MSG0|;"layer")     ; do not translate 
  177.       )                                                  
  178.       ((= table_name "Tipo lφnea")         ; translate this   
  179.         (setq table_name ;|MSG0|;"ltype")     ; do not translate 
  180.       )
  181.       ((= table_name "Estilo")         ; translate this    
  182.         (setq table_name ;|MSG0|;"style")     ; do not translate  
  183.       )                                                   
  184.       ((= table_name "SCP")           ; translate this    
  185.         (setq table_name ;|MSG0|;"ucs")       ; do not translate  
  186.       )                                                   
  187.       ((= table_name "Vista")          ; translate this    
  188.         (setq table_name ;|MSG0|;"view")      ; do not translate  
  189.       )                                                   
  190.       ((= table_name "Ventana")         ; translate this    
  191.         (setq table_name ;|MSG0|;"vport")     ; do not translate  
  192.       )
  193.     )
  194.     (do_tables2)
  195.   )
  196.   ;;
  197.   ;; Displays the defined items in a the selected table.
  198.   ;;
  199.   (defun do_tables2()
  200.     ;; If this is the first time this table is selected, set the "table"_items
  201.     ;; list to the currently defined items in the drawing by using ai_table.
  202.     (if (not (eval (read (strcat table_name "_items"))))
  203.       (set (read (eval (strcat table_name "_items")))
  204.            (ai_table table_name 7)
  205.       )
  206.     )
  207.     ;; Set current_items to a sorted version of "table"_items.
  208.     (if (and (>= (getvar "maxsort") 
  209.                (length (eval (read (strcat table_name "_items"))))
  210.              )
  211.              (eval (read (strcat table_name "_items")))
  212.         )
  213.       (setq current_items 
  214.             (acad_strlsort (eval (read (strcat table_name "_items"))))
  215.       )
  216.       (setq current_items (eval (read (strcat table_name "_items"))))
  217.     )
  218.     (start_list "table_items")          ; display the sorted version.
  219.     (mapcar 'add_list current_items)
  220.     (end_list)
  221.   )
  222.   ;;
  223.   ;; On Apply, check input, generate lists, and update the new list if all
  224.   ;; is well.  
  225.   ;;
  226.   (defun rename()
  227.     (setq report_error 1)
  228.     (and (do_old)
  229.          (do_new)
  230.          (update_list)
  231.     )
  232.     (setq report_error 0)
  233.   )
  234.   ;;
  235.   ;; Validation checking for old name.  Called on OK and when focus is removed
  236.   ;; from the old name edit box.
  237.   ;;
  238.   (defun do_old()
  239.     (setq rename_list '())
  240.     (setq new_name_list '())
  241.  
  242.     (cond 
  243.       ((and (/= "" (setq old_pattern (ai_strtrim (get_tile "old")))) 
  244.             (/= "*varφa*" old_pattern))
  245.         (setq i 0)
  246.         (setq j 1)
  247.         (setq old_star 1)   ; was nil
  248.         (setq highlight "")
  249.         ; Find first * in old_pattern.
  250.         (setq old_pattern_length (strlen old_pattern))
  251.         (while (<= j old_pattern_length)
  252.           (cond 
  253.             ((= "*" (substr old_pattern j 1)) (setq old_star j))
  254.              (T)
  255.            )
  256.            (setq j (1+ j))
  257.         )
  258. ;        (if (not (wcmatch old_pattern
  259. ;                        "*[]`#`@`.`~`[`,`'!%^&()+={}|`\\:;\"<>/]*"
  260. ;                 )
  261. ;            )
  262. ;          (progn
  263.             (foreach n current_items
  264.               (if (wcmatch n (xstrcase old_pattern))
  265.                 (progn
  266.                   (setq rename_list (cons n rename_list))
  267.                   (set_tile "table_items" (itoa i))
  268.                   (setq highlight (strcat highlight (itoa i) " "))
  269.                 )
  270.               )
  271.               (setq i (1+ i))
  272.             )    
  273. ;          )
  274. ;        )
  275.         (if rename_list 
  276.           (progn   
  277.             (set_tile "table_items" highlight)
  278.              T)                ; if there is a list return T to continue
  279.           (progn 
  280.             (if (= 1 report_error)
  281.               (set_tile "error" "Antiguo nombre no vßlido.")
  282.             )
  283.             nil             ; else set errtile and drop out.
  284.           )
  285.         )
  286.       )
  287.       (T 
  288.         (if (/= "" (setq old_indices (get_tile "table_items"))) ; get indices
  289.           (progn
  290.             (setq old_star 1)                   
  291.             (while (read old_indices)                 ; while an index remains
  292.               (setq one_index (itoa (read old_indices)))    ; get first index
  293.               (setq old_indices (substr old_indices (+ 2 (strlen one_index))))
  294.                                                             ; chop from string
  295.               (setq rename_list 
  296.                     (cons (nth (atoi one_index) current_items) rename_list)
  297.               )
  298.             )
  299.           )
  300.           (progn
  301.             (if (= 1 report_error)
  302.               (set_tile "error" "No se ha seleccionado ning·n nombre antiguo.")
  303.             )
  304.             nil
  305.           )
  306.         )                                            
  307.       )
  308.     )
  309.   )
  310.   ;;
  311.   ;; Check the validity of new name and generates new names.
  312.   ;;
  313.   (defun do_new()
  314.     (setq new_pattern (xstrcase (ai_strtrim (get_tile "new"))))
  315.     (foreach n1 rename_list
  316.       (setq pat_length (strlen new_pattern)
  317.             i          1
  318.             new_name   ""
  319.       )
  320.       (while (<= i pat_length)
  321.         (setq pat_letter (substr new_pattern i 1))
  322.         (cond 
  323.           ((= "*" pat_letter) 
  324.             (cond 
  325.               ((and old_star 
  326.                     (>= (strlen n1) old_star)
  327.                )
  328.                 ;; if there is a * in old_pattern and the length of the old 
  329.                 ;; name is longer then tag the rest of the letters on.
  330.                 (setq new_name (strcat new_name (substr n1 old_star)))
  331.               )
  332.               (T (setq new_name (strcat new_name (substr n1 i))) )
  333.             )  
  334.             (setq i (1+ pat_length))
  335.           )
  336.           ;; alphabetic, numeric, or one of three allowables.
  337.           ((wcmatch pat_letter "@,#,_,-,$,\\,+")
  338.             (setq new_name (strcat new_name (substr new_pattern i 1))
  339.                i        (1+ i)
  340.             )
  341.           )
  342.           ((= "?" pat_letter)
  343.             (setq new_name (strcat new_name (substr n1 i 1))
  344.                   i        (1+ i)
  345.             )
  346.           )
  347.           ;; if weird characters, set new_name to null and catch it later.
  348.           (T (setq new_name "")(setq i (1+ pat_length)))
  349.         )
  350.       )
  351.       (setq new_name_list (cons new_name new_name_list))
  352.     )
  353.     (setq i             -1
  354.           list_name_new (reverse new_name_list)
  355.           defined_names (ai_table table_name 7)
  356.     )
  357.  
  358.     (while (< i (- (length list_name_new) 1))
  359.       (setq i (1+ i)
  360.             n (nth i list_name_new)
  361.       )
  362.       (cond
  363.         ;; It's OK to rename an item back to original name.  If the new item
  364.         ;; is a member of the original list of items and its position in the
  365.         ;; original list corresponds to the position of the new name then the
  366.         ;; user is renaming an item back to its original name.  If it doesn't
  367.         ;; correspond then give an error message.
  368.         ((and (member n defined_names) 
  369.               (/= (length (member n defined_names)) ; old position in list
  370.                   (length (member (nth i rename_list) ; new position
  371.                                   (eval (read (strcat table_name "_items")))
  372.                           )
  373.                   )
  374.               )
  375.          )
  376.          (set_tile "error" "Nuevo nombre no vßlido.")
  377.          (setq i (1+ (length list_name_new)))  ; break out
  378.         )
  379.         ((not (snvalid n) )
  380.          (set_tile "error" "Nuevo nombre no vßlido.")
  381.          (setq i (1+ (length list_name_new)))  ; break out
  382.         )
  383.         ((= "" n)
  384.          (set_tile "error" "Nuevo nombre no vßlido.")
  385.          (setq i (1+ (length list_name_new)))  ; break out
  386.         )
  387.         ((member n (cdr (member n new_name_list)))
  388.          (set_tile "error" "Nuevo nombre repetido: no vßlido.")
  389.          (setq i (1+ (length list_name_new)))  ; break out
  390.         )
  391.         ((member n (eval (read (strcat table_name "_items"))))
  392.          (set_tile "error" "Nuevo nombre repetido: no vßlido.")
  393.          (setq i (1+ (length list_name_new)))  ; break out
  394.         )
  395.         (T (set (read (eval (strcat table_name "_items")))
  396.                 (subst 
  397.                       n                                            ; new
  398.                       (nth i rename_list)                          ; old
  399.                       (eval (read (strcat table_name "_items"))))) ; list
  400.         )
  401.       )
  402.     )  
  403.     (if (= i (- (length list_name_new) 1))
  404.       (progn 
  405.         (if (and (>= (getvar "maxsort") (length list_name_new))
  406.                  (eval (read (strcat table_name "_items")))
  407.             )
  408.           (setq current_items 
  409.             (acad_strlsort (eval (read (strcat table_name "_items"))))
  410.           ) 
  411.           (setq current_items (eval (read (strcat table_name "_items"))))
  412.         )
  413.       )
  414.       nil
  415.     )
  416.   )
  417.   ;;
  418.   ;; Called by Apply, substitutes the new name for the current item name.
  419.   ;;
  420.   (defun update_list(/ i)
  421.     (setq i             0
  422.           new_item_list current_items
  423.     )
  424.     (foreach n rename_list 
  425.       (setq new_item_list (subst (nth i list_name_new) n new_item_list)
  426.             i             (1+ i)
  427.       )
  428.     )
  429.     (start_list "table_items")
  430.     (mapcar 'add_list new_item_list)
  431.     (end_list)
  432.     (setq chflag 1)
  433.     (if (= "*varφa*" old_pattern) (set_tile "old" ""))  ; clear old name.
  434.     T
  435.   )
  436.   ;;
  437.   ;; If all input checks out, then for each table that has a corresponding
  438.   ;; old name and new name list, corresponding items in the old list and the new 
  439.   ;; list are compared and renamed if different.  For each updated table, a 
  440.   ;; message reporting the number of items renamed is displayed.
  441.   ;;
  442.   ;; Modification for foreign language use
  443.   (defun command_rename(/ orig_list count)
  444.     (foreach n tables                  
  445.       (setq tmp n)              ; restore the table entry for printing
  446.       (cond
  447.        ((= n "Bloque")         ; translate this
  448.          (setq n ;|MSG0|;"block")     ; do not translate
  449.        )
  450.        ((= n "Estilo acotaci≤n")      ; translate this
  451.          (setq n ;|MSG0|;"dimstyle")  ; do not translate
  452.        )
  453.        ((= n "Capa")         ; translate this
  454.          (setq n ;|MSG0|;"layer")     ; do not translate
  455.        )
  456.        ((= n "Tipo lφnea")         ; translate this
  457.          (setq n ;|MSG0|;"ltype")     ; do not translate
  458.        )
  459.        ((= n "Estilo")         ; translate this
  460.          (setq n ;|MSG0|;"style")     ; do not translate
  461.        )
  462.        ((= n "SCP")           ; translate this
  463.          (setq n ;|MSG0|;"ucs")       ; do not translate
  464.        )
  465.        ((= n "Vista")          ; translate this
  466.          (setq n ;|MSG0|;"view")      ; do not translate
  467.        )
  468.        ((= n "Ventana")         ; translate this
  469.          (setq n ;|MSG0|;"vport")     ; do not translate
  470.        )
  471.       )
  472.       (setq count 0)
  473.       (if (eval (read (strcat n "_items")))  
  474.         (progn 
  475.           (setq orig_list (ai_table n 7))
  476.           (setq i 0)
  477.           (foreach n1 (eval (read (strcat n "_items")))
  478.             (if (not (wcmatch n1 (nth i orig_list)))
  479.               (progn
  480.                 (command "_.rename" (strcat "_" n) (nth i orig_list) n1)
  481.                 (setq count (1+ count))
  482.               )
  483.             )
  484.             (setq i (1+ i))
  485.           )
  486.           (if (/= count 0)
  487.             (if (= count 1)  ;; singular
  488.                 (princ (strcat "\n" (itoa count) " " tmp " con otro nombre."))
  489.                 (progn       ;; plural
  490.                    (cond
  491.                      ((= n ;|MSG0|;"block")         ; do not translate
  492.                       (setq tmp "Bloques")   ; translate this (plural form)
  493.                      )
  494.                      ((= n ;|MSG0|;"dimstyle")      ; do not translate
  495.                       (setq tmp "Estilos de acotaci≤n"); translate this
  496.                      )
  497.                      ((= n ;|MSG0|;"layer")         ; do not translate 
  498.                       (setq tmp "Capas")   ; translate this
  499.                      )
  500.                      ((= n ;|MSG0|;"ltype")         ; do not translate 
  501.                       (setq tmp "Tipos de lφnea")   ; translate this
  502.                      )
  503.                      ((= n ;|MSG0|;"style")         ; do not translate
  504.                       (setq tmp "Estilos")   ; translate this
  505.                      )
  506.                      ((= n ;|MSG0|;"ucs")           ; do not translate
  507.                       (setq tmp "SCP")      ; translate this
  508.                      )
  509.                      ((= n ;|MSG0|;"view")          ; do not translate 
  510.                        (setq tmp "Vistas")   ; translate this
  511.                      )
  512.                      ((= n ;|MSG0|;"vport")         ; do not translate 
  513.                        (setq tmp "Ventanas")  ; translate this
  514.                      )
  515.                    )
  516.                    (princ (strcat "\n" (itoa count) " " tmp " con otro nombre."))
  517.                 )
  518.              )
  519.           )
  520.         )
  521.       )
  522.     )
  523.   )
  524.   ;;
  525.   ;; Put up the dialogue.
  526.   ;;
  527.   (defun ddrename_main()
  528.  
  529.     (if (not (new_dialog "ddrename" dcl_id)) (exit))
  530.     ;; This is the list of symbol table names that are dispalyed in the 
  531.     ;; listbox.  When translating these strings, make sure that the (cond)
  532.     ;; in  do_tables1() is updated to contain exact copies of these strings.
  533.     ;; Re-ordering this list for alphabetising purposes should not cause
  534.     ;; problems, but test it thoroughly.  
  535.     ;; If reordered, check out the default selection below.
  536.  
  537.     (setq tables    
  538.           '("Bloque"  "Estilo acotaci≤n"
  539.             "Capa"  "Tipo lφnea"
  540.             "Estilo" "SCP"
  541.             "Vista"  "Ventana" ))
  542.   
  543.     (setq chflag       0      ; OK needs to k now if anything has changed
  544.           report_error 0)     ; Only print the old name errors during Apply.
  545.  
  546.     (start_list "tables")
  547.     (mapcar 'add_list tables)
  548.     (end_list)
  549.  
  550.     ;; Make layer the default selection and display layer list.
  551.     (set_tile "tables" "2")  ; zero-based index
  552.     (setq table_name ;|MSG0|;"Layer")
  553.     (do_tables2)
  554.  
  555.     (action_tile "tables" "(table_selection)")
  556.     (action_tile "table_items" "(table_items)")
  557.     (action_tile "old" "(set_tile \"table_items\" \"\")(do_old)")
  558.     (action_tile "new" "(rs_error)")
  559.     (action_tile "rename" "(rs_error)(rename)")
  560.     (action_tile "accept" "(done_dialog 1)")
  561.     (action_tile "help" "(help \"\" \"ddrename\")")
  562.  
  563.     (if (and (= 1 (start_dialog)) (= 1 chflag))
  564.       (command_rename)
  565.       (princ "\nNo ha cambiado de nombre ning·n elemento. ")
  566.     )
  567.   )
  568.  
  569.   ;; Set up error function.
  570.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  571.         old_error  *error*            ; save current error function
  572.         *error* ai_error              ; new error function
  573.   )
  574.  
  575.   (setvar "cmdecho" 0)
  576.  
  577.   (cond
  578.      (  (not (ai_notrans)))                      ; transparent not OK
  579.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
  580.      (  (not (setq dcl_id (ai_dcl "ddrename"))))  ; is .DCL file loaded?
  581.  
  582.      (t 
  583.         (ai_undo_push)
  584.         (ddrename_main)                          ; proceed!
  585.         (ai_undo_pop)
  586.      )
  587.   )
  588.  
  589.   (setq *error* old_error) 
  590.   (setvar "cmdecho" old_cmd)
  591.   (princ)
  592. )
  593.  
  594. ;;;----------------------------------------------------------------------------
  595. (princ "  DDRENAME cargada.  ")
  596. (princ)
  597.